home *** CD-ROM | disk | FTP | other *** search
/ HamCall (October 1991) / HamCall (Whitehall Publishing)(1991).bin / amateur / code / morse / morse.pas < prev   
Pascal/Delphi Source File  |  1990-10-14  |  14KB  |  492 lines
  1. Program Morse;
  2.  
  3. Var
  4.    Choice      :  Char;
  5.    N, M        :  Integer;
  6.    CodeLine    :  String[72];
  7.    Letter      :  Char;
  8.    Key         :  Integer;
  9.    I           :  Integer;
  10.    F           :  Integer;
  11.    Lines       :  Integer;
  12.    WordsMin    :  Integer;
  13.    LetterFlag  :  Integer;
  14.  
  15. Procedure ShowCode;
  16.  
  17. Var
  18.    DT,DA   : String[4];
  19.  
  20. Begin
  21.    DT    := #223+#32;
  22.    DA    := #223+#223+#223+#32;
  23.    GotoXY(1,12);
  24.    ClrEOL;
  25.    GotoXY(N,12);
  26.    If N > 60 then GotoXY(60,12);
  27.    Case Letter of
  28.      'A':  Write(DT,DA);
  29.      'B':  Write(DA,DT,DT,DT);
  30.      'C':  Write(DA,DT,DA,DT);
  31.      'D':  Write(DA,DT,DT);
  32.      'E':  Write(DT);
  33.      'F':  Write(DT,DT,DA,DT);
  34.      'G':  Write(DA,DA,DT);
  35.      'H':  Write(DT,DT,DT,DT);
  36.      'I':  Write(DT,DT);
  37.      'J':  Write(DT,DA,DA,DA);
  38.      'K':  Write(DA,DT,DA);
  39.      'L':  Write(DT,DA,DT,DT);
  40.      'M':  Write(DA,DA);
  41.      'N':  Write(DA,DT);
  42.      'O':  Write(DA,DA,DA);
  43.      'P':  Write(DT,DA,DA,DT);
  44.      'Q':  Write(DA,DA,DT,DA);
  45.      'R':  Write(DT,DA,DT);
  46.      'S':  Write(DT,DT,DT);
  47.      'T':  Write(DA);
  48.      'U':  Write(DT,DT,DA);
  49.      'V':  Write(DT,DT,DT,DA);
  50.      'W':  Write(DT,DA,DA);
  51.      'X':  Write(DA,DT,DT,DA);
  52.      'Y':  Write(DA,DT,DA,DA);
  53.      'Z':  Write(DA,DA,DT,DT);
  54.      '0':  Write(DA,DA,DA,DA,DA);
  55.      '1':  Write(DT,DA,DA,DA,DA);
  56.      '2':  Write(DT,DT,DA,DA,DA);
  57.      '3':  Write(DT,DT,DT,DA,DA);
  58.      '4':  Write(DT,DT,DT,DT,DA);
  59.      '5':  Write(DT,DT,DT,DT,DT);
  60.      '6':  Write(DA,DT,DT,DT,DT);
  61.      '7':  Write(DA,DA,DT,DT,DT);
  62.      '8':  Write(DA,DA,DA,DT,DT);
  63.      '9':  Write(DA,DA,DA,DA,DT);
  64.      '.':  Write(DT,DA,DT,DA,DT,DA)
  65.      End;
  66.  
  67. End;
  68.  
  69. Procedure Dit;
  70.    Begin
  71.       Sound(F);
  72.       Delay(I);
  73.       NoSound;
  74.       Delay(I);
  75.    End;
  76.  
  77. Procedure Dah;
  78.    Begin
  79.       Sound(F);
  80.       Delay(3*I);
  81.       NoSound;
  82.       Delay(I);
  83.    End;
  84.  
  85. Procedure LSpace;
  86.    Begin
  87.       NoSound;
  88.       Delay(2*I);
  89.    End;
  90.  
  91. Procedure WSpace;
  92.    Begin
  93.       NoSound;
  94.       Delay(4*I);
  95.    End;
  96.  
  97. Procedure SoundLtr;
  98.  
  99. Var
  100.    Input          :   Integer;
  101.    Z              :   Integer;
  102.  
  103. Procedure MakeLtr;
  104.  
  105.    Begin
  106.       Key := Random(10000) mod 26;
  107.          Case Key of
  108.          1 :  Letter := 'A';
  109.          2 :  Letter := 'B';
  110.          3 :  Letter := 'C';
  111.          4 :  Letter := 'D';
  112.          5 :  Letter := 'E';
  113.          6 :  Letter := 'F';
  114.          7 :  Letter := 'G';
  115.          8 :  Letter := 'H';
  116.          9 :  Letter := 'I';
  117.         10 :  Letter := 'J';
  118.         11 :  Letter := 'K';
  119.         12 :  Letter := 'L';
  120.         13 :  Letter := 'M';
  121.         14 :  Letter := 'N';
  122.         15 :  Letter := 'O';
  123.         16 :  Letter := 'P';
  124.         17 :  Letter := 'Q';
  125.         18 :  Letter := 'R';
  126.         19 :  Letter := 'S';
  127.         20 :  Letter := 'T';
  128.         21 :  Letter := 'U';
  129.         22 :  Letter := 'V';
  130.         23 :  Letter := 'W';
  131.         24 :  Letter := 'X';
  132.         25 :  Letter := 'Y';
  133.         26 :  Letter := 'Z';
  134.         27 :  Letter := '0';
  135.         28 :  Letter := '1';
  136.         29 :  Letter := '2';
  137.         30 :  Letter := '3';
  138.         31 :  Letter := '4';
  139.         32 :  Letter := '5';
  140.         33 :  Letter := '6';
  141.         34 :  Letter := '7';
  142.         35 :  Letter := '8';
  143.         36 :  Letter := '9';
  144.         37 :  Letter := '.';
  145.         End;
  146.    End;
  147.  
  148. Procedure ShowLtr;
  149.  
  150. Var
  151.    DT,DA   : String[4];
  152.  
  153. Begin
  154.    DT    := #223+#32;
  155.    DA    := #223+#223+#223+#32;
  156.    GotoXY(25,10);
  157.    ClrEOL;
  158.    Write(Letter,'  ');
  159.    Case Letter of
  160.      'A':  Write(DT,DA);
  161.      'B':  Write(DA,DT,DT,DT);
  162.      'C':  Write(DA,DT,DA,DT);
  163.      'D':  Write(DA,DT,DT);
  164.      'E':  Write(DT);
  165.      'F':  Write(DT,DT,DA,DT);
  166.      'G':  Write(DA,DA,DT);
  167.      'H':  Write(DT,DT,DT,DT);
  168.      'I':  Write(DT,DT);
  169.      'J':  Write(DT,DA,DA,DA);
  170.      'K':  Write(DA,DT,DA);
  171.      'L':  Write(DT,DA,DT,DT);
  172.      'M':  Write(DA,DA);
  173.      'N':  Write(DA,DT);
  174.      'O':  Write(DA,DA,DA);
  175.      'P':  Write(DT,DA,DA,DT);
  176.      'Q':  Write(DA,DA,DT,DA);
  177.      'R':  Write(DT,DA,DT);
  178.      'S':  Write(DT,DT,DT);
  179.      'T':  Write(DA);
  180.      'U':  Write(DT,DT,DA);
  181.      'V':  Write(DT,DT,DT,DA);
  182.      'W':  Write(DT,DA,DA);
  183.      'X':  Write(DA,DT,DT,DA);
  184.      'Y':  Write(DA,DT,DA,DA);
  185.      'Z':  Write(DA,DA,DT,DT);
  186.      '0':  Write(DA,DA,DA,DA,DA);
  187.      '1':  Write(DT,DA,DA,DA,DA);
  188.      '2':  Write(DT,DT,DA,DA,DA);
  189.      '3':  Write(DT,DT,DT,DA,DA);
  190.      '4':  Write(DT,DT,DT,DT,DA);
  191.      '5':  Write(DT,DT,DT,DT,DT);
  192.      '6':  Write(DA,DT,DT,DT,DT);
  193.      '7':  Write(DA,DA,DT,DT,DT);
  194.      '8':  Write(DA,DA,DA,DT,DT);
  195.      '9':  Write(DA,DA,DA,DA,DT);
  196.      '.':  Write(DT,DA,DT,DA,DT,DA)
  197.      End;
  198. End;
  199.  
  200.  
  201. Procedure BeepLtr;
  202.  
  203.    Begin
  204.       Case Letter of
  205.       'A':  Begin Dit;Dah;LSpace;End;
  206.       'B':  Begin Dah;Dit;Dit;Dit;LSpace;End;
  207.       'C':  Begin Dah;Dit;Dah;Dit;LSpace;End;
  208.       'D':  Begin Dah;Dit;Dit;LSpace;End;
  209.       'E':  Begin Dit;LSpace;End;
  210.       'F':  Begin Dit;Dit;Dah;Dit;LSpace;End;
  211.       'G':  Begin Dah;Dah;Dit;LSpace;End;
  212.       'H':  Begin Dit;Dit;Dit;Dit;LSpace;End;
  213.       'I':  Begin Dit;Dit;LSpace;End;
  214.       'J':  Begin Dit;Dah;Dah;Dah;LSpace;End;
  215.       'K':  Begin Dah;Dit;Dah;LSpace;End;
  216.       'L':  Begin Dit;Dah;Dit;Dit;LSpace;End;
  217.       'M':  Begin Dah;Dah;LSpace;End;
  218.       'N':  Begin Dah;Dit;LSpace;End;
  219.       'O':  Begin Dah;Dah;Dah;LSpace;End;
  220.       'P':  Begin Dit;Dah;Dah;Dit;LSpace;End;
  221.       'Q':  Begin Dah;Dah;Dit;Dah;LSpace;End;
  222.       'R':  Begin Dit;Dah;Dit;LSpace;End;
  223.       'S':  Begin Dit;Dit;Dit;LSpace;End;
  224.       'T':  Begin Dah;LSpace;End;
  225.       'U':  Begin Dit;Dit;Dah;LSpace;End;
  226.       'V':  Begin Dit;Dit;Dit;Dah;LSpace;End;
  227.       'W':  Begin Dit;Dah;Dah;LSpace;End;
  228.       'X':  Begin Dah;Dit;Dit;Dah;LSpace;End;
  229.       'Y':  Begin Dah;Dit;Dah;Dah;LSpace;End;
  230.       'Z':  Begin Dah;Dah;Dit;Dit;LSpace;End;
  231.       '0':  Begin Dah;Dah;Dah;Dah;Dah;LSpace;End;
  232.       '1':  Begin Dit;Dah;Dah;Dah;Dah;LSpace;End;
  233.       '2':  Begin Dit;Dit;Dah;Dah;Dah;LSpace;End;
  234.       '3':  Begin Dit;Dit;Dit;Dah;Dah;LSpace;End;
  235.       '4':  Begin Dit;Dit;Dit;Dit;Dah;LSpace;End;
  236.       '5':  Begin Dit;Dit;Dit;Dit;Dit;LSpace;End;
  237.       '6':  Begin Dah;Dit;Dit;Dit;Dit;LSpace;End;
  238.       '7':  Begin Dah;Dah;Dit;Dit;Dit;LSpace;End;
  239.       '8':  Begin Dah;Dah;Dah;Dit;Dit;LSpace;End;
  240.       '9':  Begin Dah;Dah;Dah;Dah;Dit;LSpace;End;
  241.       '.':  Begin Dit;Dah;Dit;Dah;Dit;Dah;LSpace;End;
  242.       #32:  WSpace;
  243.       End;
  244.    For N := 1 to Input do
  245.       Begin
  246.          WSpace;
  247.       End;
  248.    End;
  249.  
  250. Begin
  251.    ClrScr;
  252.    GotoXY(10,10);
  253.    Write('How many spaces between letters (1 to 8)');
  254.    GotoXY(10,11);
  255.    Repeat
  256.       Read(Kbd,Choice);
  257.    Until Choice in ['1'..'8'];
  258.    Val(Choice,Input,Z);
  259.    ClrScr;
  260.    Randomize;
  261.    While Not Keypressed do
  262.       Begin
  263.          MakeLtr;
  264.          ShowLtr;
  265.          BeepLtr;
  266.       End;
  267. End;
  268.  
  269.  
  270. {***********}
  271. Procedure ReadCode;
  272.  
  273. Begin
  274.    GotoXY(1,10);
  275.    Write(Codeline);
  276.    For N := 1 to Length(CodeLine) do
  277.       Begin
  278.          GotoXY(1,6);
  279.          Write('Transmitting at ',WordsMin,' words per minute');
  280.          GotoXY(1,8);
  281.          Write('This will generate ',Lines,' Lines.  This is Line ',M);
  282.          Delay(I);
  283.          Letter := Copy(Codeline,N,1);
  284.          ShowCode;
  285.          GotoXY(N,10);
  286.          Case Letter of
  287.          'A':  Begin Dit;Dah;LSpace;End;
  288.          'B':  Begin Dah;Dit;Dit;Dit;LSpace;End;
  289.          'C':  Begin Dah;Dit;Dah;Dit;LSpace;End;
  290.          'D':  Begin Dah;Dit;Dit;LSpace;End;
  291.          'E':  Begin Dit;LSpace;End;
  292.          'F':  Begin Dit;Dit;Dah;Dit;LSpace;End;
  293.          'G':  Begin Dah;Dah;Dit;LSpace;End;
  294.          'H':  Begin Dit;Dit;Dit;Dit;LSpace;End;
  295.          'I':  Begin Dit;Dit;LSpace;End;
  296.          'J':  Begin Dit;Dah;Dah;Dah;LSpace;End;
  297.          'K':  Begin Dah;Dit;Dah;LSpace;End;
  298.          'L':  Begin Dit;Dah;Dit;Dit;LSpace;End;
  299.          'M':  Begin Dah;Dah;LSpace;End;
  300.          'N':  Begin Dah;Dit;LSpace;End;
  301.          'O':  Begin Dah;Dah;Dah;LSpace;End;
  302.          'P':  Begin Dit;Dah;Dah;Dit;LSpace;End;
  303.          'Q':  Begin Dah;Dah;Dit;Dah;LSpace;End;
  304.          'R':  Begin Dit;Dah;Dit;LSpace;End;
  305.          'S':  Begin Dit;Dit;Dit;LSpace;End;
  306.          'T':  Begin Dah;LSpace;End;
  307.          'U':  Begin Dit;Dit;Dah;LSpace;End;
  308.          'V':  Begin Dit;Dit;Dit;Dah;LSpace;End;
  309.          'W':  Begin Dit;Dah;Dah;LSpace;End;
  310.          'X':  Begin Dah;Dit;Dit;Dah;LSpace;End;
  311.          'Y':  Begin Dah;Dit;Dah;Dah;LSpace;End;
  312.          'Z':  Begin Dah;Dah;Dit;Dit;LSpace;End;
  313.          '0':  Begin Dah;Dah;Dah;Dah;Dah;LSpace;End;
  314.          '1':  Begin Dit;Dah;Dah;Dah;Dah;LSpace;End;
  315.          '2':  Begin Dit;Dit;Dah;Dah;Dah;LSpace;End;
  316.          '3':  Begin Dit;Dit;Dit;Dah;Dah;LSpace;End;
  317.          '4':  Begin Dit;Dit;Dit;Dit;Dah;LSpace;End;
  318.          '5':  Begin Dit;Dit;Dit;Dit;Dit;LSpace;End;
  319.          '6':  Begin Dah;Dit;Dit;Dit;Dit;LSpace;End;
  320.          '7':  Begin Dah;Dah;Dit;Dit;Dit;LSpace;End;
  321.          '8':  Begin Dah;Dah;Dah;Dit;Dit;LSpace;End;
  322.          '9':  Begin Dah;Dah;Dah;Dah;Dit;LSpace;End;
  323.          '.':  Begin Dit;Dah;Dit;Dah;Dit;Dah;LSpace;End;
  324.          #32:  WSpace;
  325.          End;
  326.       If Keypressed then Halt;
  327.       End;
  328.    End;
  329.  
  330. Procedure LoadCode;
  331.  
  332. Type
  333.    TxtType        =  Text;
  334.  
  335. Var
  336.    Filename       :  String[12];
  337.    TxtFile        :  TxtType;
  338.    Item           :  Char;
  339.  
  340. Begin
  341.    ClrScr;
  342.    Window(15,5,65,20);
  343.    Writeln;
  344.    Writeln('CHOOSE A FILE FROM THIS LIST');
  345.    Writeln;
  346.    Writeln('      1.  Code1');
  347.    Writeln('      2.  Code2');
  348.    Writeln('      3.  Code3');
  349.    Writeln('      4.  Code4');
  350.    Repeat
  351.       Read(Kbd,Item);
  352.    Until Item in ['1','2','3','4'];
  353.    Window(1,1,80,25);
  354.    ClrScr;
  355.    Writeln;
  356.       Case Item of
  357.          '1': Filename := 'Code1.TXT';
  358.          '2': Filename := 'Code2.TXT';
  359.          '3': Filename := 'Code3.TXT';
  360.          '4': Filename := 'Code4.TXT';
  361.       End;
  362.    Assign(TxtFile, Filename);
  363.    Reset(TxtFile);
  364.    While Not EOF(TxtFile) do
  365.       Begin
  366.          Readln(TxtFile,CodeLine);
  367.          ReadCode;
  368.       End;
  369. End;
  370.  
  371. Procedure Generator;
  372.  
  373.    Begin
  374.       ClrScr;
  375.       Writeln('How many lines');
  376.       ReadLn(Lines);
  377.       For M := 1 to lines do
  378.          Begin
  379.             CodeLine := '';
  380.             Randomize;
  381.             For N := 1 to 66 do
  382.                Begin
  383.                   Key := Random(10000) mod LetterFlag;
  384.                   Case Key of
  385.                   1 :  Letter := 'A';
  386.                   2 :  Letter := 'B';
  387.                   3 :  Letter := 'C';
  388.                   4 :  Letter := 'D';
  389.                   5 :  Letter := 'E';
  390.                   6 :  Letter := 'F';
  391.                   7 :  Letter := 'G';
  392.                   8 :  Letter := 'H';
  393.                   9 :  Letter := 'I';
  394.                  10 :  Letter := 'J';
  395.                  11 :  Letter := 'K';
  396.                  12 :  Letter := 'L';
  397.                  13 :  Letter := 'M';
  398.                  14 :  Letter := 'N';
  399.                  15 :  Letter := 'O';
  400.                  16 :  Letter := 'P';
  401.                  17 :  Letter := 'Q';
  402.                  18 :  Letter := 'R';
  403.                  19 :  Letter := 'S';
  404.                  20 :  Letter := 'T';
  405.                  21 :  Letter := 'U';
  406.                  22 :  Letter := 'V';
  407.                  23 :  Letter := 'W';
  408.                  24 :  Letter := 'X';
  409.                  25 :  Letter := 'Y';
  410.                  26 :  Letter := 'Z';
  411.                  27 :  Letter := '0';
  412.                  28 :  Letter := '1';
  413.                  29 :  Letter := '2';
  414.                  30 :  Letter := '3';
  415.                  31 :  Letter := '4';
  416.                  32 :  Letter := '5';
  417.                  33 :  Letter := '6';
  418.                  34 :  Letter := '7';
  419.                  35 :  Letter := '8';
  420.                  36 :  Letter := '9';
  421.                  37 :  Letter := '.';
  422.                  End;
  423.                  If Length(Codeline) mod 6 = 0 then Letter := #32;
  424.                  CodeLine := Codeline + Letter;
  425.                End;
  426.             ClrScr;
  427.             ReadCode;
  428.          End;
  429.    End;
  430.  
  431. Procedure Menu;
  432.  
  433.    Begin
  434.       Window(15,5,65,25);
  435.       ClrScr;
  436.       Writeln('        MORSE CODE PRACTICE');
  437.       Writeln;
  438.       Writeln('This program will:');
  439.       Writeln;
  440.       Writeln('1. Generate random text groups of 5 characters');
  441.       Writeln('   each, then send them in morse code with the');
  442.       Writeln('   cursor underlining each word as it is sent.');
  443.       Writeln;
  444.       Writeln('2. Read text files prepared by your word processor');
  445.       Writeln('   in capitals, then send the text line by line');
  446.       Writeln;
  447.       Writeln('3. Sound individual random letters well spaced');
  448.       Writeln;
  449.       Writeln('"Frequency" sets the oscillator frequency');
  450.       Writeln;
  451.       Writeln('     *** Press any key to continue ** ');
  452.       Repeat until keypressed;
  453.       ClrScr;
  454.       Writeln('MORSE CODE PRACTICE');
  455.       Writeln;
  456.       Writeln('What Speed? (Enter Words Per Minute)');
  457.       Readln(WordsMin);
  458.       I := Round(800/WordsMin);
  459.       Writeln('What Frequency');
  460.       Readln(F);
  461.       Writeln('Do you want to :');
  462.       Writeln;
  463.       Writeln('1. Generate Random Code?');
  464.       Writeln('2. Read Code From a File?');
  465.       Writeln('3. Sound individual letters?');
  466.       Writeln('4. End Program');
  467.       Repeat
  468.          Read(Kbd, Choice);
  469.       Until Choice in ['1','2','3','4'];
  470.       Window(1,1,80,25);
  471.    End;
  472.  
  473.  
  474. BEGIN
  475.    Repeat
  476.       ClrScr;
  477.       Menu;
  478.       If Choice = '1'then
  479.          Begin
  480.             ClrScr;
  481.             GotoXY(15,5);
  482.             Write('Include numerals in code groups? (Y/N)');
  483.             GotoXY(15,6);
  484.             Read(Kbd,Choice);
  485.                If Choice in ['y','Y'] then LetterFlag := 37
  486.                   Else LetterFlag := 26;
  487.             Generator;
  488.          End;
  489.       If Choice = '2' then LoadCode;
  490.       If Choice = '3' then SoundLtr;
  491.    Until Choice = '4';
  492. END.